﻿<%
'
'	七色虎建站系统
'	空间支持检测
'	用于检测空间是否支持七色虎程序，诊断空间问题。
'	如果在网页显示以上文字说明空间不支持asp
'	2012.9.15

%><!--#include file="f.asp"--><!--#include file="db.asp"--><%

Dim writable,iisver,dbtest,moduletest

iisver = Request.ServerVariables("SERVER_SOFTWARE")&"/" &Server.ScriptTimeout

If Not ifObjInstalled("Scripting.FileSystemObject") Then
	moduletest = moduletest & "<div class='b'>缺少Fso组件</div>"
End If
If Not ifObjInstalled("Microsoft.XMLHTTP") Then
	moduletest = moduletest & "<div class='b'>缺少XmlHttp组件</div>"
End If
If Not ifObjInstalled("Adodb.Stream") Then
	moduletest = moduletest & "<div class='b'>缺少Stream组件</div>"
End If
If Not ifObjInstalled("Persits.Jpeg") Then
	moduletest = moduletest & "<div class='b'>缺少AspJpeg组件</div>"
End If
If moduletest&""="" Then
	moduletest = "<div class='a'>正常</div>"
End If

'判断关键目录写入
If Not ifDirWritable("config") Then
	writable =  writable & "<div class='b'>config目录无法写入</div>"
End If
If Not ifDirWritable("upload") Then
	writable =  writable & "<div class='b'>upload目录无法写入</div>"
End If
If Not ifDirWritable("cache") Then
	writable =  writable & "<div class='b'>cache目录无法写入</div>"
End If
If Not ifDirWritable("cache\img") Then
	writable =  writable & "<div class='b'>img目录无法写入</div>"
End If
If Not ifDirWritable("wml") Then
	writable =  writable & "<div class='b'>wml目录无法写入</div>"
End If
If writable&""="" Then
	writable = "<div class='a'>正常</div>"
End If

Select Case testDbStatus
Case 0 dbtest = "<div class='b'>配置出错</div>"
Case -1 dbtest = "<div class='b'>连接出错</div>"
Case -2 dbtest = "<div class='b'>数据出错</div>"
Case Else dbtest = "<div class='a'>正常</div>"
End Select

Function testDbStatus()
	Dim fso,dbMap,conn,connstr
	dbMap = Server.MapPath(""&db&"")
	On Error Resume Next
	Err = 0
	Set fso=Server.CreateObject("Scripting.FileSystemObject")
	If Err<>0 Or Not fso.FileExists(dbMap) Then testDbStatus = 0 :Exit Function
	connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:DATABASE PASSWORD=;Data Source="&dbMap
	Set conn = server.createobject("ADODB.CONNECTION")
	conn.open connstr
	If Err<>0 Then testDbStatus = -1 :Exit Function
	conn.Execute("select top 1 id from 74hu_bbs")
	If Err<>0 Then testDbStatus = -2 :Exit Function
	Set fso=Nothing
	Set conn=Nothing
	Err = 0
	testDbStatus = 1
End Function

Response.ContentType = "text/html; charset=utf-8"
%>
<html>
<head>
<title>七色虎系统空间支持检测</title>
<style type="text/css">
body {margin:0px auto;text-align:center;min-width:250px;width:300px;}
table th{background:blue;color:#fff;}
table tr td{text-align:center;}
div.a{color:green;}
div.b{color:red;}
</style>
</head>
<body>
<table border="1" cellpadding="5" cellspacing="0" bgcolor="#ededed">
<tr><td colspan="2">安装七色虎系统需要以下支持</td></tr>
<tr><th>检测项</th><th>情况</th></tr>
<tr><td>IIS版本</td><td><%=iisver%></td></tr>
<tr><td>空间组件</td><td><%=moduletest%></td></tr>
<tr><td>目录权限</td><td><%=writable%></td></tr>
<tr><td>数据库</td><td><%=dbtest%></td></tr>
</table>
</body>
</html>